home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1993 November / JCSM Shareware Collection - 1993-11.iso / cl720 / fast278j.lzh / HEXD.F < prev    next >
Text File  |  1992-10-19  |  4KB  |  191 lines
  1. ;HEXD program in FAST.
  2. #window memory 4500
  3.  
  4. ax=0:ay=0
  5. number=0
  6.  
  7. proc printbs(n)
  8.     {
  9.     a=digits(low n)
  10.     if a<3 then repeat 3-a print " ";
  11.     printb n;
  12.     }
  13.  
  14. proc colours
  15.     {
  16.     open window ccc
  17.     for x=0 to 15
  18.     c=x+'0':if c>'9' then c+=7
  19.     colour 15
  20.     locate 3,x*2+26:print chr c;
  21.     if x<8 then locate x*2+5,22:print chr c;
  22.     for y=0 to 7
  23.     locate y*2+5,x*2+26
  24.     colour x+y*16:print chr 4;
  25.     next y,x
  26.     wait for keyscan
  27.     close window
  28.     }
  29.  
  30. proc ascii_display
  31.     {
  32.     open window display
  33.     for a=0 to 31
  34.     for b=0 to 7
  35.     locate b*2+3,a*2+8:print chr b*32+a
  36.     next b,a
  37.  
  38.     forever
  39.     {
  40.     n=ay*32+ax
  41.     colour 15
  42.     locate 20,10:print "Character: ";n;"  (Hex=";
  43.     printhb n;")  ";
  44.     x=ax*2+7:y=ay*2+2
  45.     locate y,x:print "┌─┐";
  46.     locate y+1,x:print "│";
  47.     locate y+1,x+2:print "│";
  48.     locate y+2,x:print "└─┘";
  49.     wait for keypressed:s=scan
  50.     if s=1 then close window:return
  51.     locate y,x:print "   ";
  52.     locate y+1,x:print " ";
  53.     locate y+1,x+2:print " ";
  54.     locate y+2,x:print "   ";
  55.  
  56.     if s=75 then ax--
  57.     if s=77 then ax++
  58.     if s=72 then ay--
  59.     if s=80 then ay++
  60.  
  61.     if s=71 then ax--:ay--
  62.     if s=73 then ax++:ay--
  63.     if s=79 then ay++:ax--
  64.     if s=81 then ay++:ax++
  65.  
  66.     if ax<0 then ax=31
  67.     if ax>31 then ax=0
  68.     if ay<0 then ay=7
  69.     if ay>7 then ay=0
  70.     }
  71.     }
  72.  
  73. proc display_keys
  74.     {
  75.     open window menu_key
  76.     colour 23
  77.     wait_key:
  78.     locate 18,32:printbs(peek 0|417h);
  79.     locate 18,44:printbs(peek 0|418h);
  80.     if not keypressed then goto wait_key
  81.     ks=keyscan
  82.     if ks=283 then close window:return
  83.     locate 13,35:printbs(low ks);
  84.     locate 13,47:printbs(high ks);
  85.     locate 15,32:print "KEYSCAN = ";ks;"    ";
  86.     goto wait_key
  87.     }
  88.  
  89. proc idecimal
  90.     {
  91.     open window iii
  92.     cursor 19,6:number=input
  93.     close window
  94.     }
  95.  
  96. proc ihex
  97.     {
  98.     open window iii
  99.     cursor 19,6:number=inputh
  100.     close window
  101.     }
  102.  
  103. proc numeric_display
  104.     {
  105.     open window numdisp
  106.     colour 60h
  107.     num_wait:
  108.     for r=0 to 15:x=number+r
  109.     locate r+4,26
  110.     repeat 6-digits(x) print " ";
  111.     print x;" ";
  112.     printh x;" ";
  113.     bit=32768
  114.     for k=0 to 15
  115.     if x and bit then print "1"; else print "0";
  116.     bit/=2
  117.     next k:next r
  118.     k=scan
  119.     if k=81 then number+=16
  120.     if k=73 then number-=16
  121.     if k=1 then cursor 25,0:close window:return
  122.     if k=32 then idecimal
  123.     if k=35 then ihex
  124.     goto num_wait
  125.     }
  126.  
  127. on int 1
  128.     {
  129.     if (peek 0|417h and 3)=3 then
  130.     {
  131.     position=curpos
  132.     opt=menu main
  133.     goto mm2
  134.     forever
  135.         {
  136.         opt=select main,opt
  137.         mm2:
  138.         colour 7
  139.         if not opt then goto finish
  140.         if opt=5 then stop int 1:goto finish
  141.  
  142.         if opt=1 then ascii_display
  143.         if opt=2 then numeric_display
  144.         if opt=3 then display_keys
  145.         if opt=4 then colours
  146.         }
  147.     finish:
  148.     close window
  149.     curpos=position
  150.     }
  151.     }
  152. print bios cr lf "To activate HEXD press both shift keys."
  153. stop resident
  154.  
  155. ;-- DATA ----------------------------------------------------------------------
  156. main:
  157. datab 1,5,5,3,30,11,15
  158. datab 22,6,1,'HEXD'
  159. datab 22,2,3,'Ascii table'
  160. datab 22,2,4,'Number conversion'
  161. datab 22,2,5,'Keyboard codes'
  162. datab 22,2,6,'Colours'
  163. datab 22,2,7,'Disable HEXD'
  164. datab 26
  165.  
  166. display:
  167. datab 0,0,6,1,72,22,7
  168. datab 26
  169.  
  170. menu_key:
  171. datab 1,0,26,9,52,20,23
  172. datab 22,1,1,'Push a key (ESC to exit).'
  173. datab 22,3,4,'KEY     0   SCAN      0'
  174. datab 22,3,8,'0040:0017   0040:0018'
  175. datab 26
  176.  
  177. numdisp:
  178. datab 1,0,25,1,55,21,60h
  179. datab 22,3,1,'DEC   HEX      BINARY'
  180. datab 22,1,19,20,7,'     Input:  ',20,15,'D',20,7,'ecimal '
  181. datab 20,15,'H',20,7,'ex     '
  182. datab 20,1100000b,26
  183.  
  184. iii:
  185. datab 0,0,3,15,12,21,1010000b
  186. datab 22,2,2,'Number'
  187. datab 22,2,4,'>',26
  188.  
  189. ccc:
  190. datab 0,0,20,2,59,21,7,26
  191.